home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
United Public Domain Gold 2
/
United Public Domain Gold 2.iso
/
utilities
/
pu064.dms
/
pu064.adf
/
KwikBackUp
/
Source
/
HDDisplay.mod
< prev
next >
Wrap
Text File
|
1990-03-25
|
13KB
|
464 lines
IMPLEMENTATION MODULE HDDisplay;
FROM SYSTEM IMPORT ADR, LONGSET, BITSET, INLINE, ADDRESS;
FROM Arts IMPORT Assert, BreakPoint, TermProcedure;
FROM Dos IMPORT Delay;
FROM Exec IMPORT UByte, WaitPort, GetMsg, ReplyMsg;
FROM Graphics IMPORT RastPortPtr, SetDrMd, SetAPen, SetBPen, jam1, jam2,
Move, Draw, RectFill, Text;
FROM Intuition IMPORT NewWindow, WindowPtr, ScreenFlags, ScreenFlagSet,
WindowFlags, WindowFlagSet, Gadget, GadgetFlagSet,
GadgetFlags, boolGadget, OpenWindow, CloseWindow,
IDCMPFlags, IDCMPFlagSet, Image, DrawImage,
ActivationFlags, ActivationFlagSet, strGadget,
StringInfo, Border, RefreshGadgets, IntuiText,
IntuiMessagePtr, IntuiMessage, GadgetPtr, DrawBorder,
PrintIText, AutoRequest;
FROM Strings IMPORT Length;
FROM HDImages IMPORT Images, ImageDatas, Imgwidth, Imgheight;
FROM Beep IMPORT Beep;
(*------ Definition: ------
TYPE
gadgets = (HDGadg, DiskGadg, SaveAllGadg, RegardArchivedGadg,
SetArchivedGadg, StartGadg, BackUpGadg, RestoreGadg);
ReqResults = (Retry, Continue, Cancel);
VAR
Window: WindowPtr;
Gadgets: ARRAY gadgets OF Gadget;
RP: RastPortPtr;
HDName: ARRAY[0..255] OF CHAR;
DriveName: ARRAY[0..5] OF CHAR;
*)
(*------ VARs: ------*)
VAR
NuWindow: NewWindow;
GadgImages: ARRAY Images OF Image;
ImgCnt: Images;
GdgCnt: gadgets;
Undo: ARRAY[0..255] OF CHAR;
HDInfo: StringInfo;
Borders: ARRAY[0..10] OF Border;
i: CARDINAL;
Texte: ARRAY[0..8] OF IntuiText;
DiskNameText: IntuiText;
ReqWin: WindowPtr;
ReqCnt: CARDINAL;
(*------ Type Text: ------*) (* $S- *)
PROCEDURE Type(x,y: INTEGER; String: ARRAY OF CHAR);
BEGIN
Move(RP,x,y);
Text(RP,ADR(String),Length(String));
END Type;
(*------ Init IText: ------*)
PROCEDURE SetIText(VAR iText: IntuiText;
x,y: INTEGER;
Str: ADDRESS;
next: ADDRESS);
BEGIN
WITH iText DO
frontPen := 1;
backPen := 0;
drawMode := jam2;
leftEdge := x;
topEdge := y;
iTextFont:= NIL;
iText := Str;
nextText := next;
END;
END SetIText;
(* $S+ *)
(*------ BorderData: ------*)
PROCEDURE BorderData(); (* $E- *) (* coors relative 16/128) *)
BEGIN
INLINE(- 1,- 1, 140,- 1, 140, 16, - 1, 16, - 1,- 1);
INLINE( 155,- 1, 296,- 1, 296, 16, 155, 16, 155,- 1);
INLINE( 311,- 1, 452,- 1, 452, 16, 311, 16, 311,- 1);
INLINE( 467,- 1, 608,- 1, 608, 16, 467, 16, 467,- 1);
INLINE( 544,- 82, 576,- 82, 576,- 70, 544,- 70, 544,- 82);
INLINE( 544,- 66, 576,- 66, 576,- 54, 544,- 54, 544,- 66);
INLINE( 480,- 50, 576,- 50, 576,- 38, 480,- 38, 480,- 50);
INLINE( 336,-104, 600,-104, 600,- 12, 336,- 12, 336,-104);
INLINE( 16,-104, 204,-104, 204,- 12, 16,- 12, 16,-104);
INLINE(- 1, 23, 608, 23, 608, 36, - 1, 36, - 1, 23);
INLINE(- 1, 43, 608, 43, 608, 56, - 1, 56, - 1, 43);
END BorderData;
PROCEDURE ReqBorderData(); (* $E- *)
BEGIN
INLINE( 15,11, 368,11, 368,28, 15,28, 15,11);
INLINE( 15,35, 112,35, 112,52, 15,52, 15,35);
INLINE(143,35, 240,35, 240,52, 143,52, 143,35);
INLINE(271,35, 368,35, 368,52, 271,52, 271,35);
END ReqBorderData;
(*--------------------- Redraw Window: ----------------------------------*)
PROCEDURE Redraw();
BEGIN
SetDrMd(RP,jam1); SetAPen(RP,0);
RectFill(RP,2,10,636,176);
RefreshGadgets(Window^.firstGadget,Window,NIL);
SetAPen(RP,2); SetBPen(RP,1); SetDrMd(RP,jam2);
END Redraw;
(*------------------------- Open Window: --------------------------------*)
PROCEDURE OpenDisplay();
BEGIN
(*------ Images: ------*)
FOR ImgCnt := MIN(Images) TO MAX(Images) DO
WITH GadgImages[ImgCnt] DO
leftEdge := 0;
topEdge := 0;
width := Imgwidth[ImgCnt];
height := Imgheight[ImgCnt];
depth := 2;
imageData := ImageDatas[ImgCnt];
planePick := 3;
planeOnOff := 0;
nextImage := NIL;
END;
END;
(*------ Gadgets: ------*)
FOR GdgCnt := MIN(gadgets) TO MAX(gadgets) DO
WITH Gadgets[GdgCnt] DO
IF GdgCnt#MAX(gadgets) THEN
nextGadget := ADR(Gadgets[gadgets(ORD(GdgCnt)+1)]);
ELSE
nextGadget := NIL;
END;
flags := GadgetFlagSet{};
activation := ActivationFlagSet{gadgImmediate,toggleSelect,
stringCenter};
gadgetType := boolGadget;
gadgetRender := NIL;
selectRender := NIL;
gadgetText := NIL;
mutualExclude:= LONGSET{};
specialInfo := NIL;
gadgetID := ORD(GdgCnt);
END;
END;
WITH Gadgets[HDGadg] DO
leftEdge := 47;
topEdge := 82;
width := 136;
height := 8;
INCL(flags,gadgImage);
gadgetRender := ADR(GadgImages[HardDisk]);
WITH GadgImages[HardDisk] DO
leftEdge := -7;
topEdge := -57;
END;
gadgetType := strGadget;
specialInfo:= ADR(HDInfo);
WITH HDInfo DO
buffer := ADR(HDName);
undoBuffer := ADR(Undo);
maxChars := 255;
bufferPos := 0;
dispPos := 0;
HDName := "DH0:";
Undo := "";
numChars := 3;
END;
END;
WITH Gadgets[BackUpGadg] DO
leftEdge := 224;
topEdge := 4;
width := Imgwidth[BackUp];
height := Imgheight[BackUp];
flags := flags + GadgetFlagSet{gadgImage,gadgHImage,selected};
gadgetRender := ADR(GadgImages[BackUp ]);
selectRender := ADR(GadgImages[HBackUp]);
END;
WITH Gadgets[RestoreGadg] DO
leftEdge := 216;
topEdge := 57;
width := Imgwidth[Restore];
height := Imgheight[Restore];
flags := flags + GadgetFlagSet{gadgImage,gadgHImage};
gadgetRender := ADR(GadgImages[Restore ]);
selectRender := ADR(GadgImages[HRestore]);
END;
WITH Gadgets[DiskGadg] DO
leftEdge := 360;
topEdge := 30;
width := Imgwidth[Disk];
height := Imgheight[Disk];
flags := flags + GadgetFlagSet{gadgImage,gadgHImage};
activation := activation / ActivationFlagSet{toggleSelect,relVerify};
gadgetRender := ADR(GadgImages[Disk ]);
selectRender := ADR(GadgImages[OpenDisk]);
gadgetText := ADR(DiskNameText);
SetIText(DiskNameText,36,23,ADR(DriveName),NIL);
DiskNameText.frontPen := 2;
DiskNameText.backPen := 1;
END;
FOR i:=0 TO 10 DO
WITH Borders[i] DO
leftEdge := 0;
topEdge := 0;
frontPen := 2;
drawMode := jam1;
count := 5;
xy := ADR(BorderData);
INC(xy,20*i);
IF i<10 THEN
nextBorder := ADR(Borders[i+1]);;
ELSE
nextBorder := NIL;
END;
END;
END;
SetIText(Texte[0],480,-79,ADR("Disk:") ,ADR(Texte[1]));
SetIText(Texte[1],480,-63,ADR("Track:") ,ADR(Texte[2]));
SetIText(Texte[2],496,-47,ADR(" ------ ") ,ADR(Texte[3]));
SetIText(Texte[3], 50, 4,ADR("Start") ,ADR(Texte[4]));
SetIText(Texte[4],178, 4,ADR("Set Archives") ,ADR(Texte[5]));
SetIText(Texte[5],322, 4,ADR("Regard Archives"),ADR(Texte[6]));
SetIText(Texte[6],506, 4,ADR("Save All") ,ADR(Texte[7]));
SetIText(Texte[7], 16, 26,ADR("Drawer:") ,ADR(Texte[8]));
SetIText(Texte[8], 16, 46,ADR("File:") ,NIL);
FOR GdgCnt:=SaveAllGadg TO StartGadg DO
WITH Gadgets[GdgCnt] DO
leftEdge := 8 + 156 * (3-(ORD(GdgCnt)-ORD(SaveAllGadg)));
topEdge := 118;
width := 140;
height := 16;
END;
END;
WITH Gadgets[StartGadg] DO
gadgetRender := ADR(Borders);
gadgetText := ADR(Texte);
END;
INCL(Gadgets[SetArchivedGadg].flags,selected);
INCL(Gadgets[SaveAllGadg ].flags,selected);
(*------ Window: ------*)
WITH NuWindow DO
leftEdge := 0;
topEdge := 0;
width := 640;
height := 196;
detailPen := 0;
blockPen := 1;
idcmpFlags := IDCMPFlagSet{gadgetDown, gadgetUp, closeWindow};
flags := WindowFlagSet{windowDrag, windowDepth, windowClose,
activate, gimmeZeroZero};
firstGadget:= ADR(Gadgets);
checkMark := NIL;
title := ADR("KwikBackUp -- © 1988 by Fridtjof Siebert / AMOK");
screen := NIL;
bitMap := NIL;
type := ScreenFlagSet{wbenchScreen};
minWidth := 64;
minHeight := 32;
maxWidth := -1;
maxHeight := -1;
END;
Window := OpenWindow(NuWindow);
Assert(Window#NIL,ADR("OpenWindow() failed"));
RP := Window^.rPort;
(*------ Draw into Window: ------*)
Redraw();
END OpenDisplay;
(*--------------------------- Requester: --------------------------------*)
(* $S- *)
PROCEDURE HDRequest(What: ADDRESS;
col0,col1: UByte;
retry: BOOLEAN): ReqResults;
VAR
cnt: ReqResults;
gdg: GadgetPtr;
ReqGadgets: ARRAY ReqResults OF Gadget;
ReqBorders: ARRAY [0..3] OF Border;
ReqTexte: ARRAY[0..4] OF IntuiText;
ReqMsgPtr: IntuiMessagePtr;
ReqMsg: IntuiMessage;
NuWindow: NewWindow;
rp: RastPortPtr;
BEGIN
FOR cnt := Retry TO Cancel DO
WITH ReqGadgets[cnt] DO
IF cnt#Cancel THEN
nextGadget := ADR(ReqGadgets[ReqResults(ORD(cnt)+1)]);
ELSE
nextGadget := NIL;
END;
leftEdge := 12+128*ORD(cnt);
topEdge := 30;
width := 96;
height := 16;
flags := GadgetFlagSet{};
activation := ActivationFlagSet{relVerify};
gadgetType := boolGadget;
gadgetRender:= NIL;
selectRender:= NIL;
gadgetText := NIL;
mutualExclude := LONGSET{};
specialInfo := NIL;
gadgetID := ORD(cnt);
END;
END;
FOR i:=0 TO 3 DO
WITH ReqBorders[i] DO
leftEdge := -16;
topEdge := -36;
frontPen := 2;
drawMode := jam1;
count := 5;
xy := ADR(ReqBorderData);
INC(xy,20*i);
IF i<3 THEN
nextBorder := ADR(ReqBorders[i+1]);;
ELSE
nextBorder := NIL;
END;
END;
END;
SetIText(ReqTexte[0], 8, -20,What ,ADR(ReqTexte[1]));
IF retry THEN
SetIText(ReqTexte[1], 28, 4,ADR("Retry") ,ADR(ReqTexte[2]));
SetIText(ReqTexte[2],152, 4,ADR("Ignore") ,ADR(ReqTexte[3]));
ELSE
SetIText(ReqTexte[1], 40, 4,ADR("OK") ,ADR(ReqTexte[3]));
ReqBorders[1].nextBorder := ADR(ReqBorders[3]);
ReqGadgets[Retry].nextGadget := ADR(ReqGadgets[Cancel]);
END;
SetIText(ReqTexte[3],280, 4,ADR("Cancel") ,NIL);
FOR i:=0 TO 3 DO
WITH ReqTexte[i] DO
drawMode := jam1;
frontPen := col1;
END;
END;
ReqGadgets[Retry].gadgetText := ADR(ReqTexte[0]);
ReqGadgets[Retry].gadgetRender := ADR(ReqBorders);
WITH NuWindow DO
leftEdge := 0;
topEdge := 0;
width := 384;
height := 64;
detailPen := col0;
blockPen := col1;
idcmpFlags := IDCMPFlagSet{gadgetUp};
flags := WindowFlagSet{windowDrag, windowDepth, activate,
gimmeZeroZero};
firstGadget:= ADR(ReqGadgets);
checkMark := NIL;
title := ADR("KwikBackUp:");
screen := NIL;
bitMap := NIL;
type := ScreenFlagSet{wbenchScreen};
minWidth := 64;
minHeight := 32;
maxWidth := 384;
maxHeight := 64;
END;
ReqWin := OpenWindow(NuWindow);
Beep(col0=3);
IF ReqWin=NIL THEN (* if openwindow failed try AutoRequest(): *)
SetIText(ReqTexte[0],16,16,What,NIL);
IF retry THEN
SetIText(ReqTexte[1],8,3,ADR("Retry"),NIL);
ELSE
SetIText(ReqTexte[1],8,3,ADR(" OK "),NIL);
END;
SetIText(ReqTexte[3],8,3,ADR("Cancel"),NIL);
ReqTexte[0].drawMode := jam1; ReqTexte[0].frontPen := 2;
ReqTexte[1].drawMode := jam1; ReqTexte[1].frontPen := 2;
ReqTexte[3].drawMode := jam1; ReqTexte[3].frontPen := 2;
IF AutoRequest(Window,ADR(ReqTexte[0]),ADR(ReqTexte[1]),ADR(ReqTexte[3]),
IDCMPFlagSet{}, IDCMPFlagSet{},384,64) THEN
RETURN Retry;
ELSE
RETURN Cancel;
END;
END;
rp := ReqWin^.rPort;
SetAPen(rp,col0); SetDrMd(rp,jam1); RectFill(rp,0,0,384,64);
SetAPen(rp,col1);
DrawBorder(rp,ADR(ReqBorders[0]),-16,-40);
PrintIText(rp,ADR(ReqTexte[0]),-16,-40);
RefreshGadgets(ReqWin^.firstGadget,ReqWin,NIL);
LOOP
WaitPort(ReqWin^.userPort);
ReqMsgPtr := GetMsg(ReqWin^.userPort);
IF ReqMsgPtr#NIL THEN
ReqMsg := ReqMsgPtr^;
ReplyMsg(ReqMsgPtr);
IF ReqMsg.class=IDCMPFlagSet{gadgetUp} THEN
gdg := ReqMsg.iAddress;
CloseWindow(ReqWin);
ReqWin := NIL;
RETURN ReqResults(gdg^.gadgetID);
END;
END;
END;
END HDRequest;
(* $S+ *)
(*------ CleanUp: ------*)
PROCEDURE CleanUp();
BEGIN
IF ReqWin#NIL THEN CloseWindow(ReqWin) END;
IF Window#NIL THEN CloseWindow(Window) END;
END CleanUp;
(*------ Initialization: ------*)
BEGIN
Window := NIL; ReqWin := NIL;
TermProcedure(CleanUp);
DriveName := "DF0:";
END HDDisplay.